unit zlib_Compression;
(* __________________________________________________________________ <

                        amg SoftWarE - 2003

                      autor: Andrzej Oczkowicz
                      e-mail: andrew_lz@poczta.fm

                    >> simple "interface" for zlib << 

  ______________________________________________The Matrix Has You..._
>                                                                     *)


                                                                  
interface

uses
  Classes, Zlib, SysUtils;

type
  TProgress       = procedure(Progress:Byte) of object;
  TStaticProgress = procedure(Progress:Byte);
  ErrorLEvel      = byte;


resourcestring
     rstrOutError  = 'Output stream error.';
     rstrInError   = 'Input stream error.';
     rstrZLBError  = 'No zlb archive stream.';
     rstrZLB_OK    = 'zlb ok! ;-)';


const
{ Errors codes }
  resOk       = 0;  //no error :)
  resInError  = 1;  //InData not assigned
  resOutError = 2;  //OutData not assigned
  resNoZLB    = 3;  //InData stream is not zlb stream
  resUnknown  = 4;  //other errors

{ Compressin levels }
  colNone     = 0;
  colLow      = 1;
  colMedium   = 2;
  colMax      = 3;

  HEADER_SIZE = SizeOf(Integer) + SizeOf(Byte) + SizeOf(int64);


{
  This function compress InData stream from current position to end of Stream. Compressed is stored in OutData
  Result contain error code (see errors codes).
  ErrorStr contain error message.
}


function zlb_Compress(InData:TStream; OutData:TStream; CompressionLevel:byte;
                  var ErrorStr:string; StaticProgress:TStaticProgress = nil; Progress:TProgress = nil):ErrorLevel; overload;

function zlb_Compress(var InData; InCount:int64; OutData:TStream; CompressionLevel:byte;
                  var ErrorStr:string; StaticProgress:TStaticProgress = nil; Progress:TProgress = nil):ErrorLevel; overload;

{
  This function decompress InData stream from current position to uncomp. size. Uncompressed data is stored in OutData
  Result contain error code (see errors codes).
  ErrorStr contain error message.
}
function zlb_DeCompressStrm(InData:TStream; const OutData:TStream; var CompressionLevel:byte;
                  var ErrorStr:string; StaticProgress:TStaticProgress = nil; Progress:TProgress = nil):ErrorLevel; overload;


function zlb_DeCompress(InData:TStream; var OutData; var CompressionLevel:byte;
                  var ErrorStr:string;  StaticProgress:TStaticProgress = nil; Progress:TProgress = nil):ErrorLevel; overload;

{
  UnCompressedSize : Uncompressed data size, CompressionLevel : stream compression level
  Result contain error code (see errors codes).
  ErrorStr contain error message.
}
function zlb_StreamInfo(zlb_Stream:TStream; var UnCompressedSize:int64; var CompressionLevel:byte;  var ErrorStr:string):ErrorLevel;




implementation

const
  zlbFLAG : integer = $61626C7A; //zlba

type  //helper progress class
  Pclass = class
  private
    FStatic:TStaticProgress;
    FObject:TProgress;
    FInS:TStream ;
    FMax:int64;
  public
    constructor Create(Static:TStaticProgress; AObject:TProgress; InS:TStream; Max:int64);
    procedure Progress(Sender:TObject);
  end;


function gLevel(CompressionLevel : Byte):TCompressionLevel;
begin
   if CompressionLevel in [0..3] then
     Result:=TCompressionLevel(CompressionLevel)
       else
     Result:=TCompressionLevel(2);
end;


function zlb_Compress(var InData; InCount:int64; OutData:TStream; CompressionLevel:byte;
                  var ErrorStr:string; StaticProgress:TStaticProgress = nil; Progress:TProgress = nil):ErrorLevel; overload;
var
 zlib:TCompressionStream;
 progr:pclass;
begin
  if not Assigned(OutData) then
    begin
      Result:=resOutError;
      ErrorStr:=rstrOutError;
      Exit;
    end;
   if not Assigned(@InData) then
    begin
      Result:=resInError;
      ErrorStr:=rstrInError;
      Exit;
    end;
  Result:=resOk;
  ErrorStr:=rstrZLB_OK;
  try
    if InCount <= 0 then
      Exit;
    OutData.Write(zlbFLAG, SizeOf(zlbFLAG));
    OutData.WriteBuffer(CompressionLevel, SizeOf(CompressionLevel));
    OutData.WriteBuffer(InCount, SizeOf(InCount));
    zlib:=TCompressionStream.Create(gLevel(CompressionLevel), OutData);
    progr:=pclass.Create(StaticProgress, Progress, zlib, InCount);
    try
      zlib.OnProgress:=Progr.Progress;
      Progr.Progress(Progr);
      zlib.Write(InData, InCount);
      Progr.Progress(Progr);
    finally
//      InData.Position:=inpos;
      zlib.Free;
      progr.Free;
    end;
  except
    on E:Exception do
      begin
        Result:=resUnknown;
        ErrorStr:=E.Message;
      end;
  end;
end;

function zlb_Compress(InData:TStream; OutData:TStream; CompressionLevel:byte;
                  var ErrorStr:string; StaticProgress:TStaticProgress = nil; Progress:TProgress = nil):ErrorLevel; overload;
var
 zlib:TCompressionStream;
 progr:pclass;
 inPos, DataLen:int64;

begin
  if not Assigned(OutData) then
    begin
      Result:=resOutError;
      ErrorStr:=rstrOutError;
      Exit;
    end;
   if not Assigned(InData) then
    begin
      Result:=resInError;
      ErrorStr:=rstrInError;
      Exit;
    end;
  Result:=resOk;
  ErrorStr:=rstrZLB_OK;
  try
    inPos:=InData.Position;
    DataLen:=InData.Size - inPos;
    if DataLen <= 0 then
      Exit;
    OutData.Write(zlbFLAG, SizeOf(zlbFLAG));
    OutData.WriteBuffer(CompressionLevel, SizeOf(CompressionLevel));
    OutData.WriteBuffer(DataLen, SizeOf(DataLen));
    zlib:=TCompressionStream.Create(gLevel(CompressionLevel), OutData);
    progr:=pclass.Create(StaticProgress, Progress, OutData, DataLen);
    try
      zlib.OnProgress:=Progr.Progress;
      Progr.Progress(Progr);
      zlib.CopyFrom(InData, DataLen);
      Progr.Progress(Progr);
    finally
//      InData.Position:=inpos;
      zlib.Free;
      progr.Free;
    end;
  except
    on E:Exception do
      begin
        Result:=resUnknown;
        ErrorStr:=E.Message;
      end;
  end;
end;

function zlb_DeCompress(InData:TStream; var OutData; var CompressionLevel:byte;
                  var ErrorStr:string; StaticProgress:TStaticProgress = nil; Progress:TProgress = nil):ErrorLevel;
var
  zlib:TDecompressionStream;
  progr:pclass;
  Flag:Integer;
  DataLen:int64;

begin
   if not Assigned(InData) then
    begin
      Result:=resInError;
      ErrorStr:=rstrInError;
      Exit;
    end;
  Result:=resOk;
  ErrorStr:=rstrZLB_OK;
  try
   InData.ReadBuffer(Flag, SizeOf(Flag));
   InData.ReadBuffer(CompressionLevel, SizeOf(CompressionLevel));
   InData.ReadBuffer(DataLen, SizeOf(DataLen));
   if Flag <> zlbFlag then
     begin
       ErrorStr:=rstrZLBError;
       Result:=resNoZLB;
       Exit;
     end;
    zlib:=TDecompressionStream.Create(InData);
    progr:=pclass.Create(StaticProgress, Progress, zlib, DataLen);
    try
      zlib.OnProgress:=Progr.Progress;
      Progr.Progress(Progr);
      zlib.Read(OutData, DataLen);
      Progr.Progress(Progr);
    finally
      zlib.Free;
      progr.Free;
    end;
   except
    on E:Exception do
      begin
        Result:=resUnknown;
        ErrorStr:=E.Message;
      end;
  end;
end;

function zlb_DeCompressStrm(InData:TStream; const OutData:TStream; var CompressionLevel:byte;
                  var ErrorStr:string;  StaticProgress:TStaticProgress = nil; Progress:TProgress = nil):ErrorLevel;
var
 zlib:TDecompressionStream;
 progr:pclass;
 Flag:Integer;
 DataLen:int64;

begin
  if not Assigned(OutData) then
    begin
      Result:=resOutError;
      ErrorStr:=rstrOutError;
      Exit;
    end;
   if not Assigned(InData) then
    begin
      Result:=resInError;
      ErrorStr:=rstrInError;
      Exit;
    end;
  Result:=resOk;
  ErrorStr:=rstrZLB_OK;
  try
   InData.ReadBuffer(Flag, SizeOf(Flag));
   InData.ReadBuffer(CompressionLevel, SizeOf(CompressionLevel));
   InData.ReadBuffer(DataLen, SizeOf(DataLen));
   if Flag <> zlbFlag then
     begin
       ErrorStr:=rstrZLBError;
       Result:=resNoZLB;
       Exit;
     end;
    zlib:=TDecompressionStream.Create(InData);
    progr:=pclass.Create(StaticProgress, Progress, zlib, DataLen);
    try
      zlib.OnProgress:=Progr.Progress;
      //todo: OutData.Size:=DataLen;
      Progr.Progress(Progr);
      OutData.CopyFrom(zlib, DataLen);
      Progr.Progress(Progr);
    finally
      zlib.Free;
      progr.Free;
    end;
   except
    on E:Exception do
      begin
        Result:=resUnknown;
        ErrorStr:=E.Message;
      end;
  end;
end;


function zlb_StreamInfo(zlb_Stream:TStream; var UnCompressedSize:int64; var CompressionLevel:byte;  var ErrorStr:string):ErrorLevel;
var
  flag: integer;

begin
   if not Assigned(zlb_Stream) then
    begin
      Result:=resInError;
      ErrorStr:=rstrInError;
      Exit;
    end;
  Result:=resOk;
  ErrorStr:=rstrZLB_OK;
  try
   zlb_Stream.ReadBuffer(Flag, SizeOf(Flag));
   zlb_Stream.ReadBuffer(CompressionLevel, SizeOf(CompressionLevel));
   zlb_Stream.ReadBuffer(UnCompressedSize, SizeOf(UnCompressedSize));
   if Flag <> zlbFlag then
     begin
       ErrorStr:=rstrZLBError;
       Result:=resNoZLB;
       Exit;
     end;
   except
    on E:Exception do
      begin
        Result:=resUnknown;
        ErrorStr:=E.Message;
      end;
  end;
end;

{ Pclass }

constructor Pclass.Create(Static: TStaticProgress; AObject: TProgress; InS:TStream; Max:int64);
begin
  FStatic:=Static;
  FObject:=AObject;
  FInS:=InS;
  FMax := Max;
end;

procedure Pclass.Progress(Sender: TObject);
var
 Val:Integer;
begin
  Val:=Round((FInS.Position / FMax)* 100) ;
  if Assigned(FStatic) then
    FStatic(Val);
  if Assigned(FObject) then
    FObject(Val);
end;

end.
